
=head1 PURPOSE

Provides database-specific functions for the Sybase and MS SQL Server databases 
when using the Sybase PERL database driver.

=cut

package dbPicasso::Database::Sybase::db;

use dbPicasso::Database::Helper;
use base qw(dbPicasso::Database::Helper::db);

use Data::Dumper;

sub _gen_DSN
{
    my $class  = shift;
    my %cxinfo = @_;

    my $reqDSN = join(":", "dbi", $cxinfo{Driver}, $cxinfo{Host});

    return $reqDSN;
}

sub _post_connect
{
	my $self = shift;
	my %cxinfo = @_;
	$self->do(sprintf 'use %s', $cxinfo{Database}) or return undef;

	return 1;
}

sub get_object_list
{
    my $self = shift;
    my $type = shift;
    my $typespec;

    if ($type)
    {
        my %code = (
                    'sproc' => 'P',
                    'table' => 'U',
                    'view'  => 'V',
                   );

        $typespec = $code{$type};
    }

    $typespec = $type ? "type = '$typespec'" : "type in ('P', 'U', 'V')";

    my $query = <<"EOSQL";
	             select 'Schema' as schemaname, name, type = 
	                          case type 
	                            when 'P' then 'sproc' 
	                            when 'U' then 'table'
	                            when 'V' then 'view'
	                          end 
	             from sysobjects where $typespec order by type, lower(name)
EOSQL

    print "Object query is: \n\n$query\n\n";

    my %objects;
    my $sth = $self->prepare($query);
    $sth->execute;
    
    while (my $row = $sth->fetchrow_hashref)
    {
	my $schema = $row->{schemaname};
	my $type = $row->{type};
	$objects{$schema} = {} unless defined $objects{ $schema };
	$objects{$schema}{$type} = [] unless defined $objects{ $schema }{$type};
	
	push @{ $objects{$schema}{$type} }, $row;
    }
    
    return \%objects;
}

sub get_object_ddl
{
    my $self = shift;
    my $name = shift;
    my $type = shift;
    my $ddl;

    $type = lc $type;

    if ($type eq "table")
    {
        $ddl = $self->_reconstruct_table_def($name);
    }
    else
    {
        my $sth = $self->prepare("sp_helptext '$name'");
        $sth->execute;

        my $numparts = $sth->fetchrow;    # don't use this, but need to fetch it.
        $sth->fetchrow;                   # blank record between result sets.

        while (my @part = $sth->fetchrow_array)
        {
            $ddl .= $part[0];
        }

        $ddl =~ s/^\s*//;                 # string always have leading spaces, for some reason.

        # The end of file is marked by a null character, followed by lots of
        # spaces, and potentially another null character. We just
        # want to delete from the first null in the string onwards.

        my $null = chr(0);
        $ddl =~ s/$null.*$//;
    }

    my $sql = $self->get_object_drop_code($name, $type);
    $ddl = $$sql{drop} . $ddl . $$sql{check};

    return $ddl;
}

sub get_object_drop_code
{
    my ($self, $objname, $objtype) = @_;

    $objtype = lc $objtype;

    my %keyword = (
                   'sproc' => 'procedure',
                   'table' => 'table',
                   'view'  => 'view'
                  );

    my %perms = (
                 'sproc' => "grant EXEC on $objname to PUBLIC",
                 'table' => "grant select on $objname to PUBLIC",
                 'view'  => "grant select on $objname to PUBLIC"
                );

    my %sql;
    $sql{drop} = <<"SQL";

if object_id("$objname") is not null
begin
	print 'Object "$objname" exists. Dropping it.'
	drop $keyword{$objtype} $objname
end

go

SQL

    $sql{check} = <<"SQL";

go

if object_id("$objname") is not null
begin
    print 'SUCCESS: Object "$objname" was created.'
    print 'Granting permissions...'
    $perms{$objtype}
    print 'Done'
end
else
begin
    print 'FAILURE: Object "$objname" was NOT created.'
end

go

SQL

    print "Returning sql: " . Dumper(\%sql);
    return \%sql;

}

=head1 

This private method attempts to reconstruct a table definition from syscolumns / systypes
information. It's pretty straightforward, except for the use of the syscolumns.status 
column. There's some extremely valuable sybase documentation that I'll reproduce here
for posterity's sake:

=head2 From the Sybase web site:

    * Bits 0–2 (values 1, 2, and 4) – indicate bit positioning if the column uses the bit datatype. 
      If the column uses the text/image datatype, bits 0 and 1 indicate replication status as follows:
          o 01 = always replicate
          o 10 = replicate only if changed
          o 00 = never replicate
    * Bit 3 (value 8) – indicates whether NULL values are legal in this column.
    * Bit 4 (value 16) – indicates whether more than one check constraint exists for the column.
    * Bits 5 and 6 – are used internally.
    * Bit 7 (value 128) – indicates an identity column.


=cut

sub _reconstruct_table_def
{
    my $self  = shift;
    my $table = shift;

    return undef unless $table;

    my $sql = <<"SQL";

	select	colname = col.name, 
		typename = type.name, 
		collen = col.length, 
		precision = col.prec, 
		scale = col.scale,
		status = col.status
	from sysobjects obj
		inner join syscolumns col
			on obj.id = col.id
		left join systypes type
			on col.usertype = type.usertype
	where obj.name = '$table'

SQL

    # I get some weird error about DESCRIBE_INPUT from DBD::Sybase if I use ? parameters.
    # I don't know if this is a freetds thing or what.
    my $sth = $self->prepare($sql);
    $sth->execute();

    my $table = <<TABLE;

	/* IMPORTANT:
	   This Sybase table reconstruction code is far from perfect! 
	   You WILL need to edit it before it will compile. Pay special 
	   attention to constraints and defaults.
	*/

create table $table (
TABLE

    my ($col, @coldefs);
    while ($col = $sth->fetchrow_hashref)
    {
        my $coldef = join(" ", $$col{colname}, $$col{typename});

        $coldef .= "(" . $$col{collen} . ")" if ($$col{typename} =~ /char/);
        $coldef .= "(" . $$col{precision} . "," . $$col{scale} . ")" if ($$col{precision} =~ /\d+/);

        $coldef .= " identity" if ($$col{status} & 128);
        $coldef .= " null"     if ($$col{status} & 8);

        # TODO: Automate population of the check constraint.
        # Put a comment advising the presence of a check constraint for now.
        $coldef .= " -- has check constraint. Manually add." if ($$col{status} & 16);

        push @coldefs, "\t$coldef";
    }

    $table .= join(",\n", @coldefs) . "\n";
    $table .= ")";

    $sth->finish;

    return $table;
}

sub set_error_handler
{
    my $self    = shift;
    my $handler = shift;    # coderef

    return undef unless (ref($handler) eq "CODE");

    my $abbrv = $self->{private_func_abbrev};

    $self->{"syb_err_handler"} = $handler;

    return 1;
}

sub get_object_info
{
    my $self    = shift;
    my $objname = shift;

    return $self->execQuery("sp_help $objname");
}

sub get_object_depends
{
    my $self    = shift;
    my $objname = shift;

    return $self->execQuery("sp_depends $objname");
}

sub get_object_indexes
{
    my $self = shift;
    my $objname = shift;
    
    return $self->execQuery("sp_helpindex $objname");
}

package dbPicasso::Database::Sybase::st;

use base qw(dbPicasso::Database::Helper::st);

sub more_results_func { return 'syb_more_results'; }

1;
